perm filename PT2.F4[PAG,LCS]6 blob
sn#506172 filedate 1980-04-26 generic text, type T, neo UTF8
SUBROUTINE PT2
INTEGER DSK
DIMENSION BARS(1),JBAR(1),JRN(1),MBAR(1),JTRN(1),PGTRN(1)
1,IBAR(100),NNBAR(100),U(1)
COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 /MNX/MIN,MAX,JT
COMMON /SF/KL,RT,KP,SIZE,NAMX /IPG/IPG,JPG,BRACK(0/7),
1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7) /RSIG/RSIG(0/7)
1 /KBAR/KBAR(1) /RSP/KNM(1) /ENDL/ENDLN,N,NAME,NMPG,T
COMMON RS,JA,RA,R,RB,RQ(15),KQ,NQ,JQ,JJQ,KBQ,NAQ /KNUM/KNUM
1 /STF/RSTFAC(0/7),RSTJ2 /IVV/IV(1) /ITX/ITX(19) /INDNT/IND1,INDX
COMMON /POSI/STFF(0/7),JJ2,JPQ /LLL/L,ITRANS,I,RXQ,XSIG
1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(200)
1/JLINE/JLINE,SIZX /BRJ/JTOT,TURN,NB,DSK,PGLNTH
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
1,(R8,RQ(6)),(R9,RQ(7)),(JRN,RN),(MBAR,RN(1000)),(KA,KBAR(1025))
1,(K,KBAR(1027)),(JTRN,Q),(J,KBAR(1026)),(PGTRN,KBAR(516))
1,(LCNT,IV(45)),(NDPY,IV(46)),(TOT,KBAR(2)),(JBAR,BARS,KBAR(4))
1,(IBAR,Q(3000)),(NNBAR,NBAR),(U,KBAR(1026))
DATA JLINE/200/,HX/2./,ITX/'EF-','E-','F','GF','G','AF','A',
1 'BF','B',0,'DF','D','EF','E','F+','G+','BBF','O-','O+'/,
1 SLSP/11.0/,DIV/4./,PGLNTH/10.0/
C O- = OCTAVE DOWN, O+ =OCTAVE UP. OR 1/2 STEP NUMS. MAY BE USED.
C JLINE=BASIC LINE LENGTH FAC.
C HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
C TRNSP'S ALL
145 FORMAT(F,3I)
IF(NAMX.NE.0)GO TO 2000
2009 CALL GETEXT('BARS','PAG')
CALL EXTIN(KBAR,1100)
C STAFF NAMES BEGIN IN KBAR(508) [STFNM(0)7] (NOT NOW)
CC CALL EXTIN(RSTFAC,128)
DO 245 K=0,75
245 RSTFAC(K)=U(K)
C GET BACK PERTINENT DATA
2000 TYPE 144,RSTJ2
144 FORMAT(' STAFF SIZE='F4.2,' CHANGE TO '$)
ACCEPT 145,SIZE,DSK
C TYPE 2ND NUM TO WRITE BARS/LINE DATA ON DSK FILE FOR21.DAT
IF(DSK.NE.0)DSK=-1
XSIG=0
JLINE=200
TYPE 2004
2004 FORMAT(' INDENT? '$)
ACCEPT 2101,K
IND1=0
IF(K.EQ.' '.OR.K.EQ.'N')GO TO 2008
IF(K.EQ.'Y')GO TO 2007
REREAD 111,IND1,INDX
C INDENT NUM FOR 1ST LINE AND ALL LINES
GO TO 2006
2007 TYPE 2005
2005 FORMAT(' 1ST LINE, ALL OTHERS '$)
ACCEPT 111,IND1,INDX
CC2006 BARS(1)=BARS(1)+IND1-INDX
2006 JLINE=JLINE-INDX
C IND1 INCREASES SIZE OF 1ST BAR ONLY, INDX DECREASES IDEAL LINE LENGTH.
2008 IF(IPG)GO TO 2001
C IF NOT PARTS, INDICATE 1ST PAGE NUM (TO START PAGE NUMS BEYOND 1)
TYPE 2002
2002 FORMAT(' FIRST PAGE NUMBER(0=1) AND PAGE LENGTH(0=10) -- '$)
ACCEPT 111,KNUM,K
IF(K.NE.0)PGLNTH=K
2001 TYPE 304
304 FORMAT(' TRANSP.= '$)
ACCEPT 2101,ITRANS
CALL LO2UP(ITRANS)
IF(ITRANS.GT.-20)GO TO 1101
2101 FORMAT(A3)
C NEXT FOR LETTER NAMES
DO 3101 K=1,19
3101 IF(ITRANS.EQ.ITX(K))GO TO 4101
5101 TYPE 240
GO TO 2000
240 FORMAT(' THIS TRANSP NOT OFFERED. ONLY THIS LIST IS AVAILABLE:'
1,/' EF-,E-,F,GF, G,AF,A,BF,B, DF,D,EF,E,F+,G+, BBF,O+,O-'/
1,' FOR OTHERS USE TWO PASSES.')
1101 REREAD 111,ITRANS
IF(ITRANS.EQ.0)GO TO 1304
IF(ITRANS.EQ.-12)GO TO 1011
IF(ITRANS.EQ.-10)GO TO 1011
IF(ITRANS.EQ.-7)GO TO 6101
IF(ITRANS.LT.-5)GO TO 5101
IF(ITRANS.EQ.12)GO TO 1011
IF(ITRANS.GT.9)GO TO 5101
1011 ITRANS=10-ITRANS
IF(ITRANS.EQ.22)ITRANS=18
C FOR DOWN OCT.
IF(ITRANS.EQ.-2)ITRANS=19
C -2 NOW = UP OCT.
GO TO 1304
6101 ITRANS=16
GO TO 1304
4101 ITRANS=K
1304 IF(SIZE.EQ.0)SIZE=RSTJ2
SIZX=SIZE
SIZE=SIZE/RSTJ2
101 JTOT=IND1
CC101 JTOT=0
C ABOVE ASSUMES FIRST LINE ALWAYS HAS A CLEF.
DO 22 K=1,KT
JJ=BARS(K)*SIZX+.5
JBAR(K)=JJ
22 JTOT=JTOT+JJ
JBAR(1)=JBAR(1)+IND1-INDX
33 IF(RSTJ2.EQ.0)RSTJ2=1
IF(JPG.EQ.0)JPG=1
RA=JPG*SIZX
MPG=PGLNTH/RA
C MPG=NUM OF SYSTEMS PER PAGE. PGLNTH=10 OR 13
190 FORMAT(' NUM. OF SYSTEMS/PAGE =',I2,/
1 ' CHANGE TO -- '$)
TYPE 190,MPG
ACCEPT 111,LPG
IF(LPG.NE.0)MPG=LPG
LPG=JPG
90 FORMAT(' TOTAL BAR LINES='I3)
91 FORMAT(' NUMBER OF BARS PER LINE')
NPG=MPG
LTOT=JTOT
NB=1
RA=JTOT
RA=RA/JLINE+.6
JT=RA
C USE JLINE (200 FOR NOW) AS SUGGESTED LINE LENGTH)
RA=0
609 TYPE 2003
2003 FORMAT(' FIND PAGE TURNS? '$)
ACCEPT 2101,K
CALL LO2UP(K)
TURN=1000.
KPG=0
IF(K.NE.'Y')GO TO 140
CALL FNDTRN(RPG,PGTRN,JBAR,IBAR,KT,KB)
IF(IBAR(1).NE.0)GO TO 119
140 TYPE 90,KT
TYPE 91
KPG=0
16 CALL BRJUGL(JBAR(1),KT,NBAR(1),MBAR(1),JRN(1),PGTRN(1)
1,JTRN(1))
RPG=JT
RPG=RPG/MPG
605 TYPE 604,RPG,JT,KT
IF(DSK)WRITE(21,604)RPG,JT,KT
TURN=1000.
NB=1
610 TYPE 608
604 FORMAT(F7.2,' PAGES',/,I4,' LINES',I6,' BARS')
608 FORMAT(/' TYPE LAYOUT NUMBERS(-1=HELP)-- '$)
CC611 FORMAT(3A1)
C FOR 'T' TYPE X Y FOR X PAGES, Y LINES PER PAGE.
KKT=0
KA=0
K=JT
CC ACCEPT 611,T,N,KL,KB
C GO BACK IF IT'S ALPHA. FOR READ FORMAT ERROR (!!STUPID NEW FORTRAN!!)
CC IF(T.GE.'A'.AND.T.LE.'Z')GO TO 610
ACCEPT 145,T,N,KL,KB
C TYPE 0,n TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
IF(T)GO TO 700
C GO FOR HELP
IF(KL.NE.0.OR.KB.NE.0)GO TO 110
C NO MORE THAN 50 NUMS, INCLUDING 0S (FOR PAGE MARKS)
IF(T.NE.0)GO TO 115
REREAD 306,T,SPG
GO TO 11
306 FORMAT(2F)
115 JT=T
MPG=NPG
IF(N.GT.100)GO TO 110
IF(N.EQ.0)GO TO 16
C N=0 MEANS T= NUM OF LINES DESIRED.
MPG=N
C MPG=LINES PER PAGE, JT=TOTAL NUM OF BARS
KPG=MPG
JT=JT*MPG
IF(JT.LE.KT)GO TO 16
C CATCHES REQUEST FOR TOO MANY BARS.
JT=K
606 TYPE 607
GO TO 605
607 FORMAT(' WRONG NUMBER OF BARS')
111 FORMAT(100I)
110 REREAD 111,NNBAR
IF(NBAR(2).LT.100)GO TO 911
C NEXT FOR BARS PER PAGE SYSTEM. NNBAR IS EQUIV. TO NBAR.
DO 118 KB=1,100
KP=NBAR(KB)
IF(KP.EQ.0)GO TO 119
118 IBAR(KB)=NBAR(KB)
C ADDS UP BARS
119 IF(IBAR(KB-2).NE.KT)GO TO 606
C GO BACK IF MISMATCH
MB=0
LB=1
KA=1
RPG=0
114 KKT=IBAR(KA)-MB
NB=MB+1
MB=IBAR(KA)
C RESET MB FOR NEXT TIME AROUND
MPG=IBAR(KA+1)
KP=MPG/100
C GET NUM OF PAGES
MPG=MPG-KP*100
JT=MPG*KP
116 JTOT=0
DO 125 KE=NB,KKT+NB-1
125 JTOT=JTOT+JBAR(KE)
CALL BRJUGL(JBAR(NB),KKT,NBAR(LB),MBAR(NB),JRN(NB),PGTRN(NB)
1,JTRN(NB))
IF(KP.EQ.1)GO TO 122
C DOES ONLY ONE OR TWO PAGE UNITS
124 DO 123 KE=LB+JT+1,LB+MPG+1,-1
123 NBAR(KE)=NBAR(KE-1)
NBAR(LB+MPG)=0
LB=LB+MPG+1
122 KA=KA+2
LB=1+LB+MPG
C UPDATE NBAR COUNTER
1111 RPG=RPG+KP
IF(KA.LT.KB)GO TO 114
JT=MPG*RPG
JTOT=LTOT
GO TO 605
911 DO 117 K=50,1,-1
KP=NBAR(K)
KA=KA+KP
117 IF(KP.EQ.0.AND.KA.EQ.0)KL=K
IF(KA.NE.KT)GO TO 606
C MISMATCH!
N=26-2*MOD(KL-1,12)
IF(N.EQ.26)N=0
C TO SPACE OUT STAVES VERTICALLY ???
DO 121 K=1,50
121 IF(NBAR(K).EQ.0)GO TO 120
120 MPG=K-1
C MPG=NUM OF BRACES PER PAGE.
C SPG IS SPACE TO BE SET ABOVE STAFF 0
11 IF(KPG.NE.0)MPG=KPG
CALL WRTPAG
700 IF(T.LT.-2)GO TO 609
IF(T.EQ.-2)GO TO 2009
C TYPE -3 TO GET BACK 'PAGE TURN' MODE
TYPE 701
TYPE 90,KT
GO TO 610
701 FORMAT(' FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE'//
1' A SINGLE NUMBER = NUMB. OF LINES ONLY.'//
1' TYPE X,Y FOR X PAGES, Y LINES PER PAGE.'/
1' 2,5=2 PAGES, 5 LINES, 4,10=4 PAGES, 10 LINES, ETC.'//
1' M1,M2,...0 N1,N2,...0 = ZEROS ARE PAGE MARKS.'/
1' N''S ARE NUMB. OF BARS PER LINE.'//
1' N X0A M Y0B K Z0C ETC. = '/
1' A = NUM OF LINES/PAGE, N=NUMB OF BARS/PAGE(S),
1 X =NUMB OF PAGES.'/
1' EXAMPLE: 40 208 = 8 LINES/PAGE, 40 BARS ON 2 PAGES.'//
1' NEGATIVE NUMBS IN BAR LIST ARE POSSIBLE PAGE TURN POINTS.'/
1' TYPE -2 TO RETURN TO "STAFF SIZE", -3 FOR "PAGE TURN" MODE.'/)
END